module Env where

import qualified Data.Map as Map
import Data.List
import AbsC
import PrintC

type Env = [(Sig, Context)]
type Sig = Map.Map FunIdent [FunInfo]
type Context = Map.Map Var VarInfo



{-
offsetPars :: [Parameter] -> PCOffset
offsetPars = foldr f initOffset
	where
	   f (Param _ t _) o = updateOffset o t
   -}
funInfo :: [Parameter] -> Type -> FunInfo
funInfo ps t = FI ps t

funIdent :: Id -> [a] -> FunIdent
funIdent i ps = Fun i $ length ps


vType :: VarInfo -> Maybe Type
vType (VD t _ ) = Just t
vType (VP t _ ) = Just t
vType (VErr) = Nothing

fType :: FunInfo -> Maybe Type
fType (FI _ t) = Just t
fType (FErr) = Nothing

emptyEnv:: Env
emptyEnv = [(Map.empty, Map.empty)]

newEnv:: Env -> Env
newEnv env = (Map.empty, Map.empty) : env

lookVar :: Env -> Var -> Maybe VarInfo
lookVar [] _ = Nothing
lookVar (y:ys) v = Map.lookup v $ snd y

lookFun :: Env -> FunIdent -> Maybe [FunInfo]
lookFun [] _ = Nothing
lookFun (y:ys) fi = Map.lookup fi $ fst y

lookupVar:: Env -> Var -> VarInfo
lookupVar [] v = VErr
lookupVar (y:ys) v = case Map.lookup v $ snd y of
 		Nothing -> lookupVar ys v
		Just vi -> vi
      
lookupFun:: Env -> FunIdent -> [FunInfo]
lookupFun [] fi = [FErr]
lookupFun (y:ys) fi = case Map.lookup fi $ fst y of
		Nothing -> lookupFun ys fi
		Just fs -> fs

addVar:: Env -> Var -> VarInfo -> Env
addVar e@(y:ys) v vi = (fst y, Map.insert v vi (snd y)) : ys

addFun:: Env -> FunIdent -> FunInfo -> Env
addFun e@(y:ys) i fi = case Map.lookup i $ fst y of
		Nothing -> (Map.insert i [fi] (fst y), snd y) : ys
		Just fs -> updateFunEnv e i fi fs
		
updateFunEnv:: Env -> FunIdent -> FunInfo -> [FunInfo] -> Env		
updateFunEnv e@(y:ys) i fi fs = (Map.insert i rs (fst y), snd y) : ys
   where
      rs = insertOverFun fi fs
      
insertOverFun fi fs = insertBy compFunInfo fi fs

compFunInfo (FI ps1 _) (FI ps2 _) = foldr f EQ $ reverse rs
   where
      rs = zipWith compParameter ps1 ps2
      f LT GT = GT
      f LT _ = LT
      f EQ a = a
      f GT LT = LT
      f GT _ = GT

compParameter (Param _ _ t1) (Param _ _ t2) = compare t1 t2
{-
compType (BType b1) (BType b2) = compBasicType b1 b2
compType (BType _) (CType _) = LT
compType (CType _) (BType _) = GT
compType (CType _) (CType _) = EQ

compBasicType BTChar t = case t of
   BTChar -> EQ
   _ -> LT

compBasicType BTInt t = case t of
   BTChar -> GT
   BTInt -> EQ
   BTFloat -> LT
   _ -> LT

compBasicType BTFloat t = case t of
   BTChar -> GT
   BTInt -> GT
   BTFloat -> EQ
   _ -> LT

compBasicType BTStr t = case t of
   BTVoid -> LT
   BTBool -> LT
   BTStr -> EQ
   _ -> GT
   
compBasicType BTBool t = case t of
   BTBool -> EQ
   BTVoid -> LT
   _ -> GT
   
compBasicType BTVoid t = case t of
   BTVoid -> EQ
   _ -> GT
   -}

